SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00021 DIRECTORY HANDLING ROUTINES 1 05-28-9313:37ALL SWAG SUPPORT TEAM ForEachFile Procedure IMPORT 35 {π Can any one tell me a way to make pascal (TP 6.0) search aπ complete drive, including all subdirectories, even onesπ that are not in the path, looking For a specific Fileπ extension? I.E., having the Program search For *.DOC andπ saving that to a Text File?ππ Here's part of a package I'm putting together. You'd use it like this:ππ}ππ{File Test.Pas}ππUsesπ Dos, Foreach;ππProcedure PrintAllDocs;ππ Procedure PrintFile(Var Dir: DirStr; Var S : SearchRec); Far;π beginπ Writeln('Found File ',Dir,S.Name);π end;ππbeginπ ForEachFile('c:\*.doc', { Give the mask where you want to start looking }π 0, 0, { Specify File attributes here; you'll just getπ normal Files With 0 }π True, { Search recursively }π @PrintFile); { Routine to call For each File }πend;ππbeginπ PrintAllDocs;πend.πππ{Unit ForEach}ππUnit ForEach;ππ{ Unit With a few different "foreach" Functions. }π{ This extract contains only ForEachFile. }ππInterfaceππUsesπ Dos;ππTypeπ FileStr = String[12];π TFileAction = Procedure(Var Dir : DirStr;π Var S : SearchRec; ConText : Word);ππProcedure ForEachFile(Mask : PathStr; { File wildcard mask, including path }π Attr : Byte; { File attributes }π Match : Byte; { File attributes whichπ must match attr exactly }π Subdirs : Boolean; { Whether to search recursively }π Action : Pointer);π{ Calls the Far local Procedure Action^ For each File found.π Action^ should be a local Procedure With declarationπ Procedure Action(Var Path : String; Var S : SearchRec); Far;π or, if not a local Procedure,π Procedure Action(Var Path : String; Var S : SearchRec; Dummy : Word); Far;π Each time Action is called S will be filled in For a File matchingπ the search criterion.π}ππImplementationππFunction CallerFrame : Word;π{ Returns the BP value of the caller's stack frame; used For passingπ local Procedures and Functions around. Taken from Borland's Outlineπ Unit. }π Inline(π $8B/$46/$00 { MOV AX,[BP] }π );πππ { ******** File routines ********* }ππProcedure ForEachFile(Mask : PathStr; { File wildcard mask }π Attr : Byte; { File attributes }π Match : Byte; { Attributes which must match }π Subdirs : Boolean; { Whether to search recursively }π Action : Pointer);{ Action; should point toπ a TFileAction local Far Procedure }πVarπ CurrentDir : DirStr;π Doit : TFileAction Absolute Action;π Frame : Word;ππ Procedure DoDir;π { Tests all Files in current directory. Assumes currentdir has trailingπ backslash }π Varπ S : SearchRec;π beginπ FindFirst(CurrentDir + Mask, Attr, S);π While DosError = 0 doπ beginπ if (S.Attr and Match) = (Attr and Match) thenπ Doit(CurrentDir, S, Frame);π FindNext(S);π end;π end;ππ Function RealDir(Name : FileStr) : Boolean;π beginπ RealDir := (Name <> '.') and (Name <> '..');π end;ππ Procedure AddBackslash;π beginπ CurrentDir := CurrentDir + '\';π end;ππ Procedure DoAllDirs;π Varπ S : SearchRec;π OldLength : Byte;ππ Procedure AddSuffix(Suffix : FileStr); { Separate proc to save stack space }π beginπ CurrentDir := Copy(CurrentDir, 1, OldLength) + Suffix;π end;ππ beginπ OldLength := Length(CurrentDir);π DoDir;π AddSuffix('*.*');π FindFirst(CurrentDir, Directory, S);π While DosError = 0 doπ beginπ if S.Attr = Directory thenπ beginπ if RealDir(S.Name) thenπ beginπ AddSuffix(S.Name);π AddBackslash;π DoAllDirs; { do directory recursively }π end;π end;π FindNext(S);π end;π end;ππVarπ Name : NameStr;π Ext : ExtStr;ππbegin { ForEachFile }π FSplit(Mask, CurrentDir, Name, Ext);π Mask := Name+Ext;π Frame := CallerFrame;π if CurrentDir[Length(CurrentDir)] <> '\' thenπ AddBackslash;π if Subdirs thenπ DoAllDirsπ elseπ DoDir;πend;ππend.π 2 05-28-9313:37ALL SWAG SUPPORT TEAM Search ALL Dirs and Subs IMPORT 7 Uses Crt, Dos, WinDos;πProcedure SearchSubDirs(Dir:PathStr;Target:SearchRec);πVarπ FoundDir: TSearchRec;π FileSpec: PathStr;π Path : DirStr;π DummyName: NameStr;π DummyExt : ExtStr;πbeginπ If KeyPressed then Repeat Until KeyPressed;π FileSpec:= Dir + '*.';π FindFirst('*.*', AnyFile, FoundDir);π While (DosError = 0) doπ beginπ With FoundDir doπ beginπ If Name[1] <> '.' thenπ if Directory and Attr <> 0 thenπ beginπ FSplit(FileSpec,Path,DummyName,DummyExt);π FindFirst(Path + Name + '\' ,Target);π end;π end; {with FoundDir}π if KeyPressed then Pause;π FindNext(FoundDir);π end; {read loop}π If DosError <> 18 then DosErrorExit;πend;π 3 05-28-9313:37ALL SWAG SUPPORT TEAM Search All Dirs & Subs #2IMPORT 24 AH>>Hi everyone. I have a small problem. How does one go about accessingπ >>EVERY File in every directory, sub-directory on a drive? I guess this isπ >>part of the last question, but how do you access every sub-directory?ππUnit FindFile;π{$R-}πInterfaceππUses Dos;ππTypeπ FileProc = Procedure ( x : PathStr );ππProcedure FindFiles (DirPath : PathStr; (* initial path *)π Mask : String; (* mask to look For *)π Recurse : Boolean; (* recurse into sub-dirs? *)π FileDoer : FileProc); (* what to do With found *)ππ(* Starting at <DirPath>, FindFiles will pass the path of all the Filesπ it finds that match <Mask> to the <FileDoer> Procedure. if <Recurse>π is True, all such Files in subdirectories beneath <DirPath> will beπ visited as well. if <Recurse> is False, the names of subdirectoriesπ in <DirPath> will be passed as well. *)ππImplementationππProcedure FindFiles (DirPath : PathStr; (* initial path *)π Mask : String; (* mask to look For *)π Recurse : Boolean; (* recurse into sub-dirs? *)π FileDoer : FileProc); (* what to do With found *)ππ Procedure SubVisit ( DirPath : PathStr );π Varπ Looking4 : SearchRec;ππ beginπ FindFirst ( Concat ( DirPath, Mask ), AnyFile, looking4);π While ( DosError = 0 ) Do beginπ if ( looking4.attr and ( VolumeID + Directory ) ) = 0π then FileDoer ( Concat ( DirPath, looking4.name ) );π FindNext ( Looking4 );π end; (* While *)π if Recurseπ then beginπ FindFirst ( Concat ( DirPath, '*.*' ), AnyFile, looking4);π While ( DosError = 0 ) and ( looking4.name [1] = '.' ) Doπ FindNext (looking4); (* skip . and .. directories *)π While ( DosError = 0 ) Do beginπ if ( ( looking4.attr and Directory ) = Directory )π then SubVisit ( Concat ( DirPath, looking4.name, '\' ) );π FindNext ( Looking4 );π end; (* While *)π end; (* if recursing *)π end; (* SubVisit *)πππbegin (* FindFiles *)π SubVisit ( DirPath );πend; (* FindFiles *)ππend.ππ --------------------------------------------------------------------ππProgram Visit;ππUses Dos, FindFile;ππ{$F+}πProcedure FoundOne ( Path : PathStr ); (* MUST be Compiled With $F+ *)π{$F-}πbeginπ WriteLn ( Path );πend;ππbeginπ WriteLn ( '-------------------------------------------------------------');π FindFiles ( '\', '*.*', True, FoundOne );π WriteLn ( '-------------------------------------------------------------');πend.ππ -----------------------------------------------------------------------ππFoundOne will be passed every File & subdirectory. if you just want theπsubdirectories, ignore any name that doesn't end in a '\' Character!π 4 05-28-9313:37ALL SWAG SUPPORT TEAM ALLDIRS4.PAS IMPORT 19 {π>Is there any easy way do turn *.* wildcards into a bunch of Filenames?π>This may be confusing, so here's what I want to do:π>I know C, basic, pascal, and batch. (but not too well)π>I want to make a Program to read Files from c:\ece\ and, according to myπ>Filespecs ( *.* *.dwg plot???.plt hw1-1.c) I want the Program to takeπ>each File individually, and Compress it and put it on b:. I also wantπ>the Program to work in reverse. I.E.: unpack Filespecs from b: andπ>into c:. I want this because I take so many disks to school, and Iπ>don't like packing and unpacking each File individually. I also don'tπ>want one big archive. Any suggestions as to how to do it, or what Iπ>could do is appreciated.ππThe easiest way would be to use the findfirst() and findnext()πProcedures. Here's a stub Program in TP. You'll need to put code inπthe main routine to handle command line arguments, and call fsplit()πto split up the Filenames to pass to searchDir() or searchAllDirs().πthen just put whatever processing you want to do With each File inπthe process() Procedure.π}ππUsesπ Dos, Crt;ππVarπ Path : PathStr;π Dir : DirStr;π Name : NameStr;π Ext : ExtStr;π FullName : PathStr;π F : SearchRec;π Ch : Char;π I : Integer;ππProcedure Process(dir : DirStr; s : SearchRec);πbeginπ Writeln(dir, s.name);πend;πππ{π Both searchDir and searchAllDirs require the following parametersπ path - the path to the File, which must end With a backslash.π if there is no ending backslash these won't work.π fspec - the File specification.π}ππProcedure SearchDir(Path : PathStr; fspec : String);πVarπ f : SearchRec;πbeginπ Findfirst(Path + fspec, AnyFile, f);π While DosError = 0 doπ beginπ Process(path, f);π Findnext(f);π end;πend;ππProcedure searchAllDirs(path : pathStr; fspec : String);πVarπ d : SearchRec;πbeginπ SearchDir(Path, fspec);π FindFirst(Path + '*.*', Directory, d);π While DosError = 0 doπ beginπ if (d.Attr and Directory = Directory) and (d.name[1] <> '.') thenπ beginπ SearchAllDirs(Path + d.name + '\', fspec);π end;π Findnext(d);π end;πend;ππbeginπ SearchAllDirs( '\', '*.*' );πend.π 5 05-28-9313:37ALL SWAG SUPPORT TEAM ALLDIRS5.PAS IMPORT 11 {π> Can any one tell me a way to make pascal (TP 6.0) search a Completeπ> drive, including all subdirectories, even ones that are not in theπ> path, looking For a specific File extension? I.E., having the Programπ> search For *.doC and saving that to a Text File?ππOk, here goes nothing.π}ππ{$M 65000 0 655360}π{Assign enough stack space For recursion}ππProgram FindAllFiles;ππUses Dos;ππVarπ FileName : Text;ππProcedure ScanDir(path : PathStr);ππVarπ SearchFile : SearchRec;πbeginπ if Path[Length(Path)] <> '\' thenπ Path := Path + '\';π FindFirst(Path + '*.*', $37, SearchFile); { Find Files and Directories }π While DosError = 0 do { While There are more Files }π beginπ if ((SearchFile.Attr and $10) = $10) and (SearchFile.Name[1] <> '.') thenπ ScanDir(Path + SearchFile.Name)π { Found a directory Make sure it's not . or .. Scan this dir also }π elseπ if Pos('.doC',SearchFile.Name)>0 thenπ Writeln(FileName, Path + SearchFile.Name);π { if the .doC appears in the File name, Write path to File. }π FindNext(SearchFile);π end;πend;ππbeginπ Assign(FileName,'doCS'); { File to contain list of .doCs }π ReWrite(FileName);π ScanDir('C:\'); { Drive to scan. }π Close(FileName);πend.π 6 05-28-9313:37ALL SWAG SUPPORT TEAM DELTREE.PAS IMPORT 8 Procedure ClrDir ( path : pathStr );ππVar FileInfo : searchRec;π f : File;π path2 : pathStr;π s : String;ππbegin FindFirst ( path + '\*.*', AnyFile, FileInfo );π While DosError = 0 Doπ begin if (FileInfo.Name[1] <> '.') and (FileInfo.attr <> VolumeId) thenπ if ( (FileInfo.Attr and Directory) = Directory ) thenπ begin Path2 := Path + '\' + FileInfo.Name;π ClrDir ( path2 );π endπ elseπ if ((FileInfo.Attr and VolumeID) <> VolumeID) then beginπ Assign ( f, path + '\' + FileInfo.Name );π Erase ( f );π end;ππ FindNext ( FileInfo );π end;ππ if (DosError = 18) and not ((Length(path) = 2)π and ( path[2] = ':')) thenπ RmDir ( path );ππend;π 7 05-28-9313:37ALL SWAG SUPPORT TEAM DIRDEMO.PAS IMPORT 54 { DIRDEMO.PASπ Author: Trevor Carlsen. Released into the public domain 1989π Last modification 1992.π Demonstrates in a very simple way how to display a directory in a screenπ Window and scroll backwards or Forwards. }ππUsesπ Dos,π Crt,π keyinput;ππTypeπ str3 = String[3];π str6 = String[6];π str16 = String[16];π sType = (_name,_ext,_date,_size);π DirRec = Recordπ name : NameStr;π ext : ExtStr;π size : str6;π date : str16;π Lsize,π Ldate : LongInt;π dir : Boolean;π end;ππConstπ maxdir = 1000; { maximum number of directory entries }π months : Array[1..12] of str3 =π ('Jan','Feb','Mar','Apr','May','Jun',π 'Jul','Aug','Sep','Oct','Nov','Dec');π WinX1 = 14; WinX2 = 1;π WinY1 = 65; WinY2 = 23;π LtGrayOnBlue = $17;π BlueOnLtGray = $71;π page = 22;π maxlines : Word = page;ππTypeπ DataArr = Array[1..maxdir] of DirRec;ππVarπ DirEntry : DataArr;π x, numb : Integer;π path : DirStr;π key : Byte;π finished : Boolean;π OldAttr : Byte;ππProcedure quicksort(Var s; left,right : Word; SortType: sType);π Varπ data : DataArr Absolute s;π pivotStr,π tempStr : String;π pivotLong,π tempLong : LongInt;π lower,π upper,π middle : Word;ππ Procedure swap(Var a,b);π Var x : DirRec Absolute a;π y : DirRec Absolute b;π t : DirRec;π beginπ t := x;π x := y;π y := t;π end;ππ beginπ lower := left;π upper := right;π middle:= (left + right) div 2;π Case SortType ofπ _name: pivotStr := data[middle].name;π _ext : pivotStr := data[middle].ext;π _size: pivotLong := data[middle].Lsize;π _date: pivotLong := data[middle].Ldate;π end; { Case SortType }π Repeatπ Case SortType ofπ _name: beginπ While data[lower].name < pivotStr do inc(lower);π While pivotStr < data[upper].name do dec(upper);π end;π _ext : beginπ While data[lower].ext < pivotStr do inc(lower);π While pivotStr < data[upper].ext do dec(upper);π end;π _size: beginπ While data[lower].Lsize < pivotLong do inc(lower);π While pivotLong < data[upper].Lsize do dec(upper);π end;π _date: beginπ While data[lower].Ldate < pivotLong do inc(lower);π While pivotLong < data[upper].Ldate do dec(upper);π end;π end; { Case SortType }π if lower <= upper then beginπ swap(data[lower],data[upper]);π inc(lower);π dec(upper);π end;π Until lower > upper;π if left < upper then quicksort(data,left,upper,SortType);π if lower < right then quicksort(data,lower,right,SortType);π end; { quicksort }ππFunction Form(st : String; len : Byte): String;π { Replaces spaces in a numeric String With zeroes }π Varπ x : Byte ;π beginπ Form := st;π For x := 1 to len doπ if st[x] = ' ' thenπ Form[x] := '0'π end;ππProcedure ReadDir(Var count : Integer);π { Reads the current directory and places in the main Array }π Varπ DirInfo : SearchRec;ππ Procedure CreateRecord;π Varπ Dt : DateTime;π st : str6;π beginπ With DirEntry[count] do beginπ FSplit(DirInfo.name,path,name,ext); { Split File name up }π if ext[1] = '.' then { get rid of dot }π ext := copy(ext,2,3);π name[0] := #8; ext[0] := #3; { Force to a set length For Formatting }π Lsize := DirInfo.size;π Ldate := DirInfo.time;π str(DirInfo.size:6,size);π UnPackTime(DirInfo.time,Dt);π date := '';π str(Dt.day:2,st);π date := st + '-' + months[Dt.month] + '-';π str((Dt.year-1900):2,st);π date := date + st + #255#255;π str(Dt.hour:2,st);π date := date + st + ':';π str(Dt.Min:2,st);π date := date + st;π date := Form(date,length(date));π dir := DirInfo.attr and Directory = Directory;π end; { With }π end; { CreateRecord }ππ begin { ReadDir }π count := 0; { For keeping a Record of the number of entries read }π FillChar(DirEntry,sizeof(DirEntry),32); { initialize the Array }π FindFirst('*.*',AnyFile,DirInfo);π While (DosError = 0) and (count < maxdir) do beginπ inc(count);π CreateRecord;π FindNext(DirInfo);π end; { While }π if count < page thenπ maxlines := count;π quicksort(DirEntry,1,count,_name);π end; { ReadDir }ππProcedure DisplayDirectory(n : Integer);π Varπ x,y : Integer;π beginπ y := 1;π For x := n to n + maxlines doπ With DirEntry[x] do beginπ GotoXY(4,y);inc(y);π Write(name,' ');π Write(ext,' ');π if dir then Write('<DIR>')π else Write(' ');π Write(size:8,date:18);π end; { With }π end; { DisplayDirectory }ππbegin { main }π ClrScr;π GotoXY(5,24);π OldAttr := TextAttr;π TextAttr := BlueOnLtGray;π Write(' F1=Sort by name F2=Sort by extension F3=Sort by size F4=Sort by date ');π GotoXY(5,25);π Write(' Use arrow keys to scroll through directory display - <ESC> quits ');π TextAttr := LtGrayOnBlue;π Window(WinX1,WinX2,WinY1,WinY2); { make the Window }π ClrScr;π HiddenCursor;π ReadDir(numb);π x := 1; finished := False;π Repeatπ DisplayDirectory(x); { display maxlines Files }π Case KeyWord ofπ F1 {name} : beginπ x := 1;π quicksort(DirEntry,1,numb,_name);π end;π F2 {ext} : beginπ x := 1;π quicksort(DirEntry,1,numb,_ext);π end;π F3 {size} : beginπ x := 1;π quicksort(DirEntry,1,numb,_size);π end;π F4 {date} : beginπ x := 1;π quicksort(DirEntry,1,numb,_date);π end;π home : x := 1;π endKey : x := numb - maxlines;π UpArrow : if x > 1 thenπ dec(x);π DownArrow : if x < (numb - maxlines) thenπ inc(x);π PageDn : if (x + page) > (numb - maxlines) thenπ x := numb - maxlinesπ else inc(x,page);π PageUp : if (x - page) > 0 thenπ dec(x,page)π else x := 1;π escape : finished := Trueπ end; { Case }π Until finished;π NormalCursor;π TextAttr := OldAttr;π ClrScr;πend.ππ 8 05-28-9313:37ALL SWAG SUPPORT TEAM DIREXIST.PAS IMPORT 7 {π re: Finding a directoryππ>Obviously that's not the quickest routine in the world, and thoughπ>it works, I was wondering if you have anything easier/faster?ππ ...I don't know how much better this routine is, but you mayπ want to give it a try:π}ππ{ Determine if a directory exists. }ππFunction DirExist(st_Dir : DirStr) : Boolean;πVarπ wo_Fattr : Word;π fi_Temp : File;πbeginπ assign(fi_Temp, (st_Dir + '.'));π getfattr(fi_Temp, wo_Fattr);π if (Doserror <> 0) thenπ DirExist := Falseπ elseπ DirExist := ((wo_Fattr and directory) <> 0)πend; { DirExist. }ππ{πnotE: The "DirStr" Type definition is found in the standard TPπ Dos Unit. Add this Unit to your Program's "Uses" statementπ to use this routine.π}π 9 05-28-9313:37ALL SWAG SUPPORT TEAM DIRTREE.PAS IMPORT 105 Program Vtree2;ππ{$B-,D+,R-,S-,V-}π{π ┌────────────────────────────────────────────────────┐π │ Uses and GLOBAL VarIABLES & ConstANTS │π └────────────────────────────────────────────────────┘π}ππUsesπ Crt, Dos;ππConstπ NL = #13#10;π NonVLabel = ReadOnly + Hidden + SysFile + Directory + Archive;ππTypeππ FPtr = ^Dir_Rec;ππ Dir_Rec = Record { Double Pointer Record }π DirName : String[12];π DirNum : Integer;π Next : Fptr;π end;ππ Str_Type = String[65];ππVarπ Version : String;π Dir : str_Type;π Loop : Boolean;π Level : Integer;π Flag : Array[1..5] of String[20];π TreeOnly : Boolean;π Filetotal : LongInt;π Bytetotal : LongInt;π Dirstotal : LongInt;π tooDeep : Boolean;π ColorCnt : Byte;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure Beepit │π └────────────────────────────────────────────────────┘π}ππProcedure Beepit;ππbeginπ Sound (760); { Beep the speaker }π Delay (80);π NoSound;πend;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure Usage │π └────────────────────────────────────────────────────┘π}ππProcedure Usage;ππbeginπ BEEPIT;π Write (NL,π 'Like the Dos TREE command, and similar to PC Magazine''s VTREE, but gives',NL,π 'you a Graphic representation of your disk hierarchical tree structure and',NL,π 'the number of Files and total Bytes in each tree node (optionally can be',NL,π 'omitted). Also allows starting at a particular subdirectory rather than',NL,π 'displaying the entire drive''s tree structure. Redirection of output and',NL,π 'input is an option.',NL,NL, 'USAGE: VTREE2 {path} {/t} {/r}',NL,NL,π '/t or /T omits the number of Files and total Bytes inFormation.',NL,π '/r or /R activates redirection of input and output.',NL,NL, Version);π Halt;πend;ππ{π┌────────────────────────────────────────────────────┐π│ Function Format │π└────────────────────────────────────────────────────┘π}ππFunction Format (Num : LongInt) : String; {converts Integer to String}π {with commas inserted }πVarπ NumStr : String[12];π Place : Byte;ππbeginπ Place := 3;π STR (Num, NumStr);π Num := Length (NumStr); {re-use Num For Length value }ππ While Num > Place do {insert comma every 3rd place}π beginπ inSERT (',',NumStr, Num - (Place -1));π inC (Place, 3);π end;ππ Format := NumStr;πend;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure DisplayDir │π └────────────────────────────────────────────────────┘π}ππProcedure DisplayDir (DirP : str_Type; DirN : str_Type; Levl : Integer;π NumSubsVar2 : Integer; SubNumVar2 : Integer;π NumSubsVar3 : Integer;π NmbrFil : Integer; FilLen : LongInt);ππ{NumSubsVar2 is the # of subdirs. in previous level;π NumSumsVar3 is the # of subdirs. in the current level.π DirN is the current subdir.; DirP is the previous path}ππConstπ LevelMax = 5;πVarπ BegLine : String;π MidLine : String;π Blank : String;π WrtStr : String;ππbeginππ if Levl > 5 thenπ beginπ BEEPIT;π tooDeep := True;π Exit;π end;ππ Blank := ' '; { Init. Variables }π BegLine := '';π MidLine := ' ──────────────────';ππ if Levl = 0 then { Special handling For }π if Dir = '' then { initial (0) dir. level }π if not TreeOnly thenπ WrtStr := 'ROOT ──'π elseπ WrtStr := 'ROOT'π elseπ if not TreeOnly thenπ WrtStr := DirP + ' ──'π elseπ WrtStr := DirPπ elseπ begin { Level 1+ routines }π if SubNumVar2 = NumSubsVar2 then { if last node in subtree, }π begin { use └─ symbol & set flag }π BegLine := '└─'; { padded With blanks }π Flag[Levl] := ' ' + Blank;π endπ else { otherwise, use ├─ symbol }π begin { & set flag padded With }π BegLine := '├─'; { blanks }π Flag[Levl] := '│' + Blank;π end;ππ Case Levl of { Insert │ & blanks as }π 1: BegLine := BegLine; { needed, based on level }π 2: Begline := Flag[1] + BegLine;π 3: Begline := Flag[1] + Flag[2] + BegLine;π 4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;π 5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;π end; {end Case}ππ if (NumSubsVar3 = 0) then { if cur. level has no }π WrtStr := BegLine + DirN { subdirs., leave end blank}π elseπ beginπ WrtStr := BegLine + DirN + COPY(Midline,1,(13-Length(DirN)));π if Levl < LevelMax thenπ WrtStr := WrtStr + '─┐'π else { if level 5, special }π begin { end to indicate more }π DELETE (WrtStr,Length(WrtStr),1); { levels }π WrtStr := WrtStr + '»';π end;π end;π end; { end level 1+ routines }ππ if ODD(ColorCnt) thenπ TextColor (3)π elseπ TextColor (11);π inC (ColorCnt);ππ if ((Levl < 4) or ((Levl = 4) and (NumSubsVar3=0))) and not TreeOnly thenπ WriteLn (WrtStr,'':(65-Length(WrtStr)), Format(NmbrFil):3,π Format(FilLen):11)π elseπ WriteLn (WrtStr); { Write # of Files & Bytes }π { only if it fits, else }πend; { Write only tree outline }πππ{π ┌────────────────────────────────────────────────────┐π │ Procedure DisplayHeader │π └────────────────────────────────────────────────────┘π}ππProcedure DisplayHeader;ππbeginπ WriteLn ('DIRECtoRIES','':52,'FileS',' ByteS');π WriteLn ('═══════════════════════════════════════════════════════════════════════════════');πend;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure DisplayTally │π └────────────────────────────────────────────────────┘π}ππProcedure DisplayTally;ππbeginπ WriteLn('':63,'════════════════');π WriteLn('NUMBER of DIRECtoRIES: ', Dirstotal:3, '':29,π 'toTALS: ', Format (Filetotal):5, Format (Bytetotal):11);πend;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure ReadFiles │π └────────────────────────────────────────────────────┘π}ππProcedure ReadFiles (DirPrev : str_Type; DirNext : str_Type;π SubNumVar1 : Integer; NumSubsVar1 : Integer);ππVarπ FileInfo : SearchRec;π FileBytes : LongInt;π NumFiles : Integer;π NumSubs : Integer;π Dir_Ptr : FPtr;π CurPtr : FPtr;π FirstPtr : FPtr;ππbeginπ FileBytes := 0;π NumFiles := 0;π NumSubs := 0;π Dir_Ptr := nil;π CurPtr := nil;π FirstPtr := nil;ππ if Loop thenπ FindFirst (DirPrev + DirNext + '\*.*', NonVLabel, FileInfo);π Loop := False; { Get 1st File }ππ While DosError = 0 do { Loop Until no more Files }π beginπ if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') thenπ beginπ if (FileInfo.attr = directory) then { if fetched File is dir., }π begin { store a Record With dir. }π NEW (Dir_Ptr); { name & occurence number, }π Dir_Ptr^.DirName := FileInfo.name;{ and set links to }π inC (NumSubs); { other Records if any }π Dir_Ptr^.DirNum := NumSubs;π if CurPtr = nil thenπ beginπ Dir_Ptr^.Next := nil;π CurPtr := Dir_Ptr;π FirstPtr := Dir_Ptr;π endπ elseπ beginπ Dir_Ptr^.Next := nil;π CurPtr^.Next := Dir_Ptr;π CurPtr := Dir_Ptr;π end;π endπ elseπ begin { Tally # of Bytes in File }π FileBytes := FileBytes + FileInfo.size;π inC (NumFiles); { Increment # of Files, }π end; { excluding # of subdirs. }π end;π FindNext (FileInfo); { Get next File }π end; {end While}ππ Bytetotal := Bytetotal + FileBytes;π Filetotal := Filetotal + NumFiles;π Dirstotal := Dirstotal + NumSubs;ππ DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,π NumFiles, FileBytes); { Pass info to & call }π inC (Level); { display routine, & inc. }π { level number }πππ While (FirstPtr <> nil) do { if any subdirs., then }π begin { recursively loop thru }π Loop := True; { ReadFiles proc. til done }π ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,π FirstPtr^.DirNum, NumSubs);π FirstPtr := FirstPtr^.Next;π end;ππ DEC (Level); { Decrement level when }π { finish a recursive loop }π { call to lower level of }π { subdir. }πend;ππ{π ┌────────────────────────────────────────────────────┐π │ Procedure Read_Parm │π └────────────────────────────────────────────────────┘π}ππProcedure Read_Parm;ππVarπ Cur_Dir : String;π Param : String;π i : Integer;ππbeginππ if ParamCount > 3 thenπ Usage;π Param := '';ππ For i := 1 to ParamCount do { if either param. is a T, }π begin { set TreeOnly flag }π Param := ParamStr(i);π if Param[1] = '/' thenπ Case Param[2] ofπ 't','T': beginπ TreeOnly := True;π if ParamCount = 1 thenπ Exit;π end; { Exit if only one param }ππ 'r','R': beginπ ASSIGN (Input,''); { Override Crt Unit, & }π RESET (Input); { make input & output }π ASSIGN (Output,''); { redirectable }π REWrite (Output);π if ParamCount = 1 thenπ Exit;π end; { Exit if only one param }π '?' : Usage;ππ elseπ Usage;π end; {Case}π end;ππ GETDIR (0,Cur_Dir); { Save current dir }π For i := 1 to ParamCount doπ beginπ Param := ParamStr(i); { Set Var to param. String }π if (POS ('/',Param) = 0) thenπ beginπ Dir := Param;π{$I-} CHDIR (Dir); { Try to change to input }π if Ioresult = 0 then { dir.; if it exists, go }π begin { back to orig. dir. }π{$I+} CHDIR (Cur_Dir);π if (POS ('\',Dir) = Length (Dir)) thenπ DELETE (Dir,Length(Dir),1); { Change root symbol back }π Exit; { to null, 'cause \ added }π end { in later }π elseπ beginπ BEEPIT;π WriteLn ('No such directory -- please try again.');π HALT;π end;π end;π end;πend;ππ{π ┌────────────────────────────────────────────────────┐π │ MAin Program │π └────────────────────────────────────────────────────┘π}ππbeginππ Version := 'Version 1.6, 7-16-90 -- Public Domain by John Land';π { Sticks in EXE File }ππ Dir := ''; { Init. global Vars. }π Loop := True;π Level := 0;π TreeOnly := False;π tooDeep := False;π Filetotal := 0;π Bytetotal := 0;π Dirstotal := 1; { Always have a root dir. }π ColorCnt := 1;ππ ClrScr;ππ if ParamCount > 0 thenπ Read_Parm; { Deal With any params. }ππ if not TreeOnly thenπ DisplayHeader;ππ ReadFiles (Dir,'',0,0); { do main read routine }ππ TextColor(Yellow);ππ if not TreeOnly thenπ DisplayTally; { Display totals }ππ if tooDeep thenπ WriteLn (NL,NL,'':22,'» CANnot DISPLAY MorE THAN 5 LEVELS «',NL);π { if ReadFiles detects >5 }π { levels, tooDeep flag set}ππend.π 10 05-28-9313:37ALL SWAG SUPPORT TEAM DIRVIEW.PAS IMPORT 16 {πWell, here goes...a directory viewer, sorry it has no box but theπcommand that i used to create the box was from a Unit. Weel, the Programπis very "raw" but i think it's enough to give you an idea...π}ππProgram ListBox;ππUsesπ Crt, Dos;ππConstπ S = ' ';ππVarπ List : Array[1..150] of String[12];π AttrList : Array[1..150] of String[15];π Pos, First : Integer;π C : Char;π Cont : Integer;π DirInfo : SearchRec;π NumFiles : Integer;ππbeginπ TextBackground(Black);π TextColor(LightGray);π ClrScr;ππ For Cont := 1 to 15 doπ beginπ List[Cont] := '';π AttrList[Cont] := '';π end;ππ NumFiles := 0;π FindFirst('C:\*.*', AnyFile, DirInfo);ππ While DosError = 0 doπ beginπ Inc(NumFiles, 1);π List[NumFiles] := Concat(DirInfo.Name,π Copy(S, 1, 12 - Length(DirInfo.Name)));π If (DirInfo.Attr = $10) Thenπ AttrList[NumFiles] := '<DIR>'π Elseπ Str(DirInfo.Size, AttrList[NumFiles]);π AttrList[NumFiles] := Concat(AttrList[NumFiles],π Copy(S, 1, 9 - Length(AttrList[NumFiles])));π FindNext(DirInfo);π end;ππ First := 1;π Pos := 1;ππ Repeatπ For Cont := First To First + 15 doπ beginπ If (Cont - First + 1 = Pos) Thenπ beginπ TextBackground(Blue);π TextColor(Yellow);π endπ Elseπ beginπ TextBackGround(Black);π TextColor(LightGray);π end;π GotoXY(30, Cont - First + 3);π Write(' ', List[Cont], ' ', AttrList[Cont]);π end;π C := ReadKey;π If (C = #72) Thenπ If (Pos > 1) Thenπ Dec(Pos, 1)π Elseπ If (First > 1) Thenπ Dec(First,1);ππ If (C = #80) Thenπ If (Pos < 15) Thenπ Inc(Pos, 1)π Elseπ If (First + 15 < NumFiles) Thenπ Inc(First,1);π Until (Ord(c) = 13);πend.π 11 05-28-9313:37ALL SWAG SUPPORT TEAM FAST-DEL.PAS IMPORT 8 { DR> DEL/ERASE command is able to erase an entire directory by using DEL *.*π DR> With such speed. It clearly has a method other than deleting File byπ DR> File.ππ Function $41 of Int $21 will do what you want. You'll need toπmake an ASCIIZ Filename of the path and File(s), and set a Pointerπto it in DS:DX. When it returns, if the carry flag (CF) is set,πthen AX holds the Dos error code.π}πFunction DosDelete (FileName : PathStr) : Word; {returns error if any}πVar Regs : Registers;πbeginπ FileName[65] := 0; {make asciiz- maybe, not sure}π Regs.DS := Seg(FileName); {segment to String}π Regs.DX := offset(FileName)+1; {add one since f[0] is length}π Regs.AH := $41;π Regs.AL := 0; {Initialize}π Intr ($21, Regs);π if Regs.AL <> 0 {error} then DosDelete := Regs.AX else DosDelete := 0;πend;π 12 05-28-9313:37ALL SWAG SUPPORT TEAM MAKEDIR1.PAS IMPORT 19 Program MakeChangeDir;ππ{ Purpose: - Make directories where they don't exist }π{ }π{ Useful for: - Installation Type Programs }π{ }π{ Useful notes: - seems to handles even directories With extentions }π{ (i.e. DIRDIR.YYY) }π{ - there are some defaults that have been set up :- }π{ change if needed }π{ - doesn't check to see how legal the required directory }π{ is (i.e. spaces, colon in the wrong place, etc.) }π{ }π{ Legal junk: - this has been released to the public as public domain }π{ - if you use it, give me some credit! }π{ }ππVarπ Slash : Array[1..20] of Integer;ππProcedure MkDirCDir(Target : String);πVarπ i,π count : Integer;π dir,π home,π tempdir : String;ππbeginπ { sample directory below to make }π Dir := Target;π { add slash at end if not given }π if Dir[Length(Dir)] <> '\' thenπ Dir := Dir + '\';π { if colon where normally is change to that drive }π if Dir[2] = ':' thenπ ChDir(Copy(Dir, 1, 2))π elseπ { assume current drive (and directory) }π beginπ GetDir(0, Home);π if Dir[1] <> '\' thenπ Dir := Home + '\' + Dirπ elseπ Dir := Home + Dir;π end;ππ Count := 0;π { search directory For slashed and Record them }π For i := 1 to Length(Dir) doπ beginπ if Dir[i] = '\' thenπ beginπ Inc(Count);π Slash[Count] := i;π end;π end;π { For each step of the way, change to the directory }π { if get error, assume it doesn't exist - make it }π { then change to it }π For i := 2 to Count doπ beginπ TempDir := Copy(Dir, 1, Slash[i] - 1);π {$I-}π ChDir(TempDir);π if IOResult <> 0 thenπ beginπ MkDir(TempDir);π ChDir(TempDir);π end;π end;πend;ππbeginπ MkDirCDir('D:\HI.ZZZ\GEEKS\2JKD98');πend.π 13 05-28-9313:37ALL SWAG SUPPORT TEAM MAKEDIR2.PAS IMPORT 7 {π Hi Mark, there is a Procedure in Turbo Pascal called MkDir that allowsπyou to create a subdirectory. However if you want source code For a similarπroutine try the following. I just whipped it up so it doesn't contain anyπerror checking, but you could add a simple if else after the Dos call toπcheck the register flags. Anyhow, I hope that this helps ya out.π}πProcedure Make_Directory (Directory: String);π{ parameters: Directory - name of the new directoryπ sample-call: Make_Directory('\tools') }πVarπ Regs: Registers;πbeginπ With Regs doπ beginπ Directory := Directory + chr(0);π AX := $3900;π DS := Seg(Directory[1]);π DX := ofs(Directory[1]);π MSDos(Dos.Registers(Regs));π end;πend;π 14 08-18-9312:22ALL JOSE ALMEIDA Get a programs directory IMPORT 9 ª╢ { Gets the program directory.π Part of the Heartware Toolkit v2.00 (HTfile.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Get_Prg_Dir : string;ππ{ DESCRIPTION:π Gets the program directory.π SAMPLE CALL:π St := Get_Prg_Dir;π RETURNS:π The program directory, e.g., E:\TP\π NOTES:π The program directory is always where the program .EXE file is located.π This function add a backslash at the end of string. }ππvarπ Tmp : string;ππBEGIN { Get_Prg_Dir }π Tmp := ParamStr(0);π while (Tmp[Length(Tmp)] <> '\') and (Length(Tmp) <> 0) doπ Delete(Tmp,Length(Tmp),1);π if Tmp = '' thenπ Tmp := Get_Cur_Dir;π Get_Prg_Dir := Tmp;πEND; { Get_Prg_Dir }π 15 08-27-9319:58ALL LAWRENCE JOHNSTONE Every Dir in Pascal IMPORT 11 ª╢ {πLAWRENCE JOHNSTONEππ│Can someone give me some code (in TP) that recognizes all Sub-dirsπ│and Sub-sub-dirs, etc. in drive C and changes into every single oneπ│of them one at a time?π}ππPROGRAM EveryDir;ππUSESπ DOSππPROCEDURE ProcessDirs( Path: DOS.PathStr );πVARπ SR : SearchRec;πBEGINπ IF Path[Length(Path)] <> '\' THEN { Make sure last char is '\' }π Path := Path + '\';ππ { Change to directory specified by Path. Handle root as special case }π {$I-}π IF (Length(Path) = 3) AND (Copy(Path, 2, 2) = ':\') THENπ ChDir(Path)π ELSEπ ChDir(Copy(Path, 1, Length(Path) - 1);π IF IOResult <> 0 THENπ EXIT; { Quit if we get a DOS error }π {$I-}ππ { Process all subdirectories of that directory, except for }π { the '.' and '..' aliases }π FindFirst(Path + '*.*', Directory, SR);π WHILE DosError = 0 DOπ BEGINπ IF ((SR.Attr AND Directory) <> 0) ANDπ (SR.Name <> '.') AND (SR.Name <> '..') THENπ ProcessDirs( Path + SR.Name );π FindNext(SR);π END; { while }πEND; {ProcessDirs}ππVARπ CurDir : DOS.PathStr;ππBEGINπ GetDir(3, CurDir); { Get default directory on C }π ProcessDirs('C:\'); { Process all directories on C }π ChDir(CurDir); { Restore default directory on C }πEND.π 16 08-27-9319:59ALL PER-ERIC LARSSON Find a file anywhere IMPORT 18 ª╢ {πPER-ERIC LARSSONππ> I've seen some posts asking how to search through directories or how toπ> find a File anywhere on the disk, so here's a little Procedure I wroteπ> to do it... Give it a whirl and feel free to ask questions...ππThere is a built in trap in the method you describe. I've fallen into it manyπtimes myself so here's a clue. The problem:πif Your Procedure (that is called once per File) does some processing of theπFile you SHOULD first make a backup copy. personally I rename the originalπFile to .BAK and then take that File as input, writing to a new File With theπoriginal name, perhaps deleting the .bak File if everything works out fine.πFor most purposes this works fine. But if you do this using findnext to findπthe next File to work With it will Repeat itself til the end of time orπdiskspace.ππTherefore i recommend :πFirst get all Filenames to work With,πThen start processing the Files.π}ππProcedure runFile(ft : String);πbeginπ { Process File here}πend;ππProcedure RUNALLFileS(FT : String);πTypeπ plista = ^tlista;π tlista = Recordπ namn : String;π prev : plista;π end;πVarπ S : SearchRec;π Dir : DirStr;π Name : NameStr;π Ext : ExtStr;π pp : plista;ππFunction insertbefore(before : plista) : plista;πVarπ p : plista;πbeginπ getmem(p, sizeof(tlista));π p^.prev := before;π insertbefore := p;πend;ππFunction deleteafter(before : plista) : plista;πbeginπ deleteafter := before^.prev;π freemem(before, sizeof(tlista));πend;ππbeginπ pp := nil;π FSplit(fT, Dir, Name, Ext);π FINDFIRST(ft, $3f, S);π While DosERROR = 0 DOπ beginπ if (S.ATTR and $18) = 0 thenπ beginπ pp := insertbefore(pp);π pp^.namn := dir + s.name;π end;π FINDNEXT(S);π end;π if pp <> nil thenπ Repeatπ runFile(pp^.namn);π pp := deleteafter(pp);π Until pp = nil;πend;ππbeginπ if paramcount > 0 thenπ beginπ For filaa := 1 to paramcount doπ runALLFileS(paramstr(filaa));π end;π Writeln('Klar')πend.ππ{πThis is a cutout example from a Program i wroteπIt won't compile but it'll show a way to do it !π}π 17 08-27-9321:21ALL JON KENT Setting a files path IMPORT 11 ª╢ {πJON KENTππHere's one way to set a File's path "on the fly" using Typed Constants.π}ππUsesπ Dos;ππConstπ TestFile1 : String = 'TEST1.DAT';π TestFile2 : String = 'DATA\TEST2.DAT';πVarπ CurrentPath : String;ππFunction FileStretch(SType : Byte; FileFullName : String) : String;πVarπ P : PathStr;π D : DirStr;π N : NameStr;π E : ExtStr;πbeginπ P := FExpand(FileFullName);π FSplit(P, D, N, E);π if D[LENGTH(D)] = '\' thenπ D[0] := CHR(PRED(LENGTH(D)));π Case SType OFπ 1 : FileStretch := D;π 2 : FileStretch := N + E;π 3 : FileStretch := D + '\' + N;π 4 : FileStretch := N;π else FileStretch := '';π end;πend;ππbeginπ CurrentPath := FileStretch(1,ParamStr(0)); { Get EXE's Path }π TestFile1 := CurrentPath + '\' + TestFile1; { Set DAT Paths }π TestFile2 := CurrentPath + '\' + TestFile2;ππ {...}ππend.π{-----------------------------}ππ{ if CurrentPath = C:\WORK thenππ TestFile1 = C:\WORK\TEST1.DATπ TestFile2 = C:\WORK\DATA\TEST2.DATππ This works Really well when you want to store a Program's configurationπ File or data Files in the same directory as the Program regardless itsπ location.π} 18 11-02-9310:27ALL DAVID DRZYZGA Multiple Dir Picks SWAG9311 22 ª╢ {πDAVID DRZYZGAππ> And I can't seem to get the OpDir system to work With multiple Files, orπ> at least I can't get the "tagging" Function to work.ππHere's a somewhat stripped snipit of code from one of my apps that will giveπyou a clear example of how to use the multiple pick Function of the DirListπObject:π}ππProgram DirTest;ππ{$I OPDEFINE.INC}ππUsesπ Dos,π OpRoot,π OpConst,π OpString,π OpCrt,π OpCmd,π OpFrame,π OpWindow,π OpPick,π OpDir,π OpColor;ππConstπ SliderChar = '▓';π ScrollBarChar = '░';π Frame1 : FrameArray = '┌└┐┘──││';π Counter : Word = 1;ππVarπ Dir : DirList;π Finished : Boolean;π SelectedItem : Word;π DirWinOpts : LongInt;π I : Integer;ππProcedure ProcessFile(FileName : String);πbeginπ {This is where you would process each of the tagged Files}πend;ππbeginπ DirWinOpts := DefWindowOptions+wBordered;π if not Dir.InitCustom(20, 4, 50, 19, {Window coordinates}π DefaultColorSet, {ColorSet}π DirWinOpts, {Window options}π MaxAvail, {Heap space For Files}π PickVertical, {Pick orientation}π MultipleFile) {Command handler}π thenπ beginπ WriteLn('Failed to Init DirList, Status = ', InitStatus);π Halt;π end;ππ {Set desired DirList features}π With Dir doπ beginπ wFrame.AddShadow(shBR, shSeeThru);π wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 1, 1, SliderChar,π ScrollBarChar, DefaultColorSet);ππ SetSelectMarker(#251' ', '');π SetPosLimits(1, 1, ScreenWidth, ScreenHeight-1);π SetPadSize(1, 1);π diOptionsOn(diOptimizeSize);π AddMaskHeader(True, 1, 30, heTC);π SetSortOrder(SortDirName);π SetNameSizeTimeFormat('<dir>', 'Mm/dd/yy', 'Hh:mmt');π SetMask('*.*', AnyFile);π end;ππ {<AltP>: process selected list}π PickCommands.AddCommand(ccUser0, 1, $1900, 0);ππ {Pick Files}π Finished := False;π Repeatπ Dir.Process;π Case Dir.GetLastCommand ofπ ccSelect : ;π ccError : ;π ccUser0 :π beginπ Counter := 1;π if Dir.GetSelectedCount > 0 thenπ beginπ Dir.InitSequence(SelectedItem);π While Dir.HaveSelected(SelectedItem) doπ beginπ ProcessFile(Dir.GetMultiPath(SelectedItem));π Inc(Counter);π Dir.NextSelected(SelectedItem);π Dir.ResetList;π end;π endπ end;ππ ccQuit : Finished := True;π end;π Until Finished;ππ Dir.Erase;π ClrScr;π Dir.Done;πend.π 19 11-02-9306:08ALL HERBERT ZARB Change File Attr SWAG9311 7 ª╢ { Updated FILES.SWG on November 2, 1993 }ππ{πHerbert Zarb <panther!jaguar!hzarb@relay.iunet.it>ππ This simple Program changes the attribute of the File or directory fromπ hidden to archive or vice-versa...π}ππProgram hide_unhide;π{ Accepts two command line parameters :π 1st parameter can be either +h (hide) or -h(unhide).π 2nd parameter must be the full path }πUsesπ Dos;ππConstπ bell = #07;π hidden = $02;π archive = $20;ππVarπ f : File;ππbeginπ if paramcount >= 2 thenπ beginπ Assign(f, paramstr(2));π if paramstr(1) = '+h' thenπ SetFAttr(f, hidden)π elseπ if paramstr(1) = '-h' thenπ SetFAttr(f, Archive)π elseπ Write(bell);π endπ elseπ Write(bell);πend.π 20 09-26-9309:10ALL MARTIN RICHARDSON Check for Directory SWAG9311 7 ª╢ π{*****************************************************************************π * Function ...... IsDir()π * Purpose ....... To check for the existance of a directoryπ * Parameters .... Dir Dir to check forπ * Returns ....... TRUE if Dir existsπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION IsDir( Dir: STRING ) : BOOLEAN;πVARπ fHandle: FILE;π wAttr: WORD;πBEGINπ WHILE Dir[LENGTH(Dir)] = '\' DO DEC( Dir[0] );π Dir := Dir + '\.';π ASSIGN( fHandle, Dir );π GETFATTR( fHandle, wAttr );π IsDir := ( (wAttr AND DIRECTORY) = DIRECTORY );πEND;ππ 21 11-02-9306:08ALL TIMO SALMI Another Change File Attr SWAG9311 11 ª╢ { Updated FILES.SWG on November 2, 1993 }ππ{πts@uwasa.fi (Timo Salmi)ππ Q: How can one hide (or unhide) a directory using a TP Program?ππ A: SetFAttr which first comes to mind cannot be used For this.πInstead interrupt Programming is required. Here is the code.πIncidentally, since MsDos 5.0 the attrib command can be used to hideπand unhide directories.π(* Hide a directory. Before using it would be prudent to checkπ that the directory exists, and that it is a directory.π With a contribution from Jan Nielsen jak@hdc.hha.dkπ Based on information from Duncan (1986), p. 410 *)π}πProcedure HIDE(dirname : String);πVarπ regs : Registers;πbeginπ FillChar(regs, SizeOf(regs), 0); { standard precaution }π dirname := dirname + #0; { requires ASCII Strings }π regs.ah := $43; { Function }π regs.al := $01; { subFunction }π regs.ds := Seg(dirname[1]); { point to the name }π regs.dx := Ofs(dirname[1]);π regs.cx := 2; { set bit 1 on } { to unhide set regs.cx := 0 }π Intr ($21, regs); { call the interrupt }π if regs.Flags and FCarry <> 0 then { were we successful }π Writeln('Failed to hide');πend;π
